home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Apple II Magazines (PO)
/
Nibble Volume 12, No. 12 (1991-12)(MindCraft Publishing)(Side A)[a].zip
/
Nibble Volume 12, No. 12 (1991-12)(MindCraft Publishing)(Side A)[a].po
/
DIR.SAVER.bas
< prev
next >
Wrap
BASIC Source File
|
1996-12-24
|
20KB
|
441 lines
10 REM ************************
20 REM * DIRECTORY SAVER *
30 REM * by Charles T. Hill *
40 REM * Copyright (c) 1991 *
50 REM * Mindcraft Publ. Corp *
60 REM * Lincoln, MA 01773 *
70 REM ************************
80 :
90 REM INITIALIZE VARIABLES
100 ONERR GOTO 4180
110 PD = 0: IF PEEK(48640) = 76 THEN PD = 1: REM PRODOS
120 D$ = CHR$(4): PRINT D$;"PR#3":HT = 1403:W = 79:WB = 79:TC = 9:DL = 20
130 DIM FI$(100),W$(20),DI$(105): IF PD = 0 THEN TC = 3:WB = 29:DL = 18
140 LB$ = " NAME TYPE BLOCKS MODIFIED": REM SPACES 1,11,2,2
150 LB$ = LB$ +" TIME CREATED TIME ENDFILE SUBTYPE": REM SPACES 3,2,4,2,1
160 LD$ = " NAME T BLK": REM SPACES 1,27,1
170 AD$(1) = "AW20-DB":AD$(2) = "AWGS-DB":AD$(3) = "TEXT"
180 WP(1) = 16:WP(2) = 20:WP(3) = 28:WP(4) = 39:WP(5) = 45
190 WP(6) = 56:WP(7) = 62:WP(8) = 71:WP(9) = 79
200 WD(1) = 31:WD(2) = 33:WD(3) = 37
210 :
220 REM GREETING
230 HOME : PRINT : VTAB 3
240 PRINT SPC( 32);"DIRECTORY SAVER"
250 PRINT SPC( 31);"by Charles T. Hill": PRINT
260 PRINT SPC( 31);"Copyright (C) 1991"
270 PRINT SPC( 27);"Mindcraft Publishing Corp."
280 PRINT SPC( 31);"Lincoln, MA 01773"
290 PRINT : PRINT
300 PRINT SPC( 15);"Directory Saver saves directories as ASCII files,"
310 PRINT SPC( 15);"optionally formatted to load into a database"
320 PRINT SPC( 15);"in Appleworks 2.0 or 3.0 or in Appleworks GS."
330 PRINT
340 PRINT SPC( 15);"Use letters or up-down arrows to change lines,"
350 PRINT SPC( 15);"right-left arrows for next or previous page."
360 PRINT SPC( 15);"RETURN selects subdirectory, ESC backs up or exits."
370 PRINT SPC( 15);"TAB changes width, CTRL-S saves directory."
380 PRINT : PRINT
390 :
400 REM INPUT PREFIX
410 LA$ = "": REM RESET LABELS TO INDICATE DIR NOT READ FOR RESTART
420 IF PD = 0 THEN 1940: REM DOS 3.3 disk
430 SV = 0: REM RESET FLAG FOR WRITING PRODOS DIRECTORY
440 PRINT : PRINT SPC( 8);"PREFIX OR SLOT NUMBER: ";
450 IS = 1: GOSUB 1310: REM GET LINE
460 IF GL$ = "" OR GL$ = CHR$(27) THEN 1880: REM CHECK FOR END
470 PS$ = GL$:SN = VAL(PS$)
480 IF (SN <1 OR SN >7) THEN P$ = PS$: GOTO 540: REM not a slot
490 PRINT : PRINT SPC( 17);"DRIVE NUMBER: ";
500 IS = 0: GOSUB 1310: REM GET LINE
510 IF GL$ = CHR$(27) THEN 1880: REM CHECK FOR END
520 PD$ = GL$
530 P$ = ",S" +PS$ +",D" +PD$: REM CONSTRUCT PATH USING SLOT,DRIVE
540 PRINT D$;"PREFIX";P$: REM ENTER PATH
550 PRINT D$;"PREFIX": INPUT P$: REM RETRIEVE FULL PREFIX
560 P$ = LEFT$(P$, LEN(P$) -1): REM strip trailing slash
570 :
580 REM OPEN DIRECTORY
590 IF PD = 0 THEN TF = 0: GOTO 2540: REM DOS3.3 DISK
600 VTAB 23: POKE HT,79: PRINT : REM AVOID BLANK LINE ABOVE
610 EOD = 0:FS = 0:PG = 0
620 X = FRE(0): REM CLEAR MEMORY OF OLD VALUES OF CHANGED STRINGS
630 PRINT D$;"CLOSE";P$
640 PRINT D$;"OPEN ";P$;",TDIR"
650 PRINT D$;"READ";P$: IF FS = 1 THEN 730
660 INPUT A$: INPUT LA$: INPUT A$: REM READ HEADER
670 IF FS >0 THEN FOR I = 1 TO FS: INPUT A$: NEXT : GOTO 730
680 :
690 REM READ DIRECTORY FILES
700 IF PD = 0 THEN 2540: REM DOS3.3 DISK
710 IF EOD = 1 THEN GOTO 850: REM NO MORE FILES TO DISPLAY
720 PG = PG +1: VTAB 23: POKE HT,79: PRINT : REM AVOID BLANK LINE ABOVE
730 FOR J = 1 TO DL: REM NUMBER OF DISPLAY LINES
740 INPUT FI$(J): REM READ FILEINFO
750 IF SV >0 THEN VTAB 23: POKE HT,75: INVERSE : PRINT FS +J;: NORMAL
760 GOSUB 1660: REM CHECK FOR ESCAPE
770 IF FI$(J) = "" THEN INPUT "";ST$:EOD = 1: GOTO 790: REM END OF DIR
780 NEXT
790 NL = J -1: REM NUMBER OF LINES READ
800 IF SV >0 THEN VTAB 23: POKE HT,75: INVERSE : PRINT FS +NL;" ";: NORMAL
810 OI = 1: REM RESET DISPLAY LINE
820 IF SV >0 THEN 3570: REM WRITE DIRECTORY
830 :
840 REM SELECT DIRECTORY ENTRY
850 HOME : PRINT P$: INVERSE : VTAB 2: PRINT SPC( 1);LB$: NORMAL
860 LW$ = LEFT$(LB$,WB): VTAB 2: POKE HT,0: PRINT SPC( 1);LW$: REM PRODOS
870 LS$ = LEFT$(LD$,W): IF PD = 0 THEN VTAB 4: PRINT SPC( 1);LS$: REM DOS3.3
880 FOR I = 1 TO NL: GOSUB 1110: NEXT : GOSUB 1190:I = OI: GOSUB 1100
890 IF PD = 1 AND EOD = 1 THEN VTAB NL +3: IF NL <20 THEN PRINT
900 IF PD = 1 AND EOD = 1 THEN PRINT ST$
910 VTAB 1: POKE HT,68: PRINT "PAGE ";PG;: POKE HT,77: PRINT "-->";
920 IF EOD = 1 THEN VTAB 1: POKE HT,77: PRINT "<--";
930 GOSUB 1240: IF K = 13 THEN K = I: GOTO 1540: REM RETURN
940 IF K = 9 THEN 2630: REM AT TAB
950 IF K = 19 THEN SV = 1: GOTO 2690: REM CTRL-S
960 IF K = 1 THEN SV = 2: GOTO 2690: REM CTRL-A
970 IF K = 8 THEN GOSUB 1110: GOTO 590: REM LEFT
980 IF K = 11 THEN GOSUB 1110:I = I -1: REM UP
990 IF K = 21 THEN GOSUB 1110: GOTO 700: REM RIGHT
1000 IF K = 10 THEN GOSUB 1110:I = I +1: REM DOWN
1010 IF K = 27 THEN 1710: REM ESC -- RESTART
1020 IF K >96 AND K <123 THEN K = K -32: REM SMALL LETTERS
1030 IF K >64 AND K <85 THEN GOSUB 1110:I = K -64: REM LETTERS A-T
1040 IF I >NL THEN I = NL
1050 IF I <1 THEN I = 1
1060 OI = I
1070 GOSUB 1100: GOTO 930
1080 :
1090 REM DISPLAY DIRECTORY FILES
1100 INVERSE
1110 V = I +2: IF PD = 0 THEN V = I +4: REM MAKE ROOM FOR DOS3.3 LABELS
1120 WI$ = LEFT$(FI$(I),W)
1130 VTAB V: POKE HT,1: PRINT WI$;: NORMAL
1140 INVERSE :VA = I +64
1150 VTAB V: POKE HT,0: PRINT CHR$(VA);
1160 NORMAL : RETURN
1170 :
1180 REM DISPLAY INSTRUCTIONS
1190 VTAB 23: POKE HT,0: INVERSE : PRINT SPC( 2);"DIRECTORY SAVER:";
1200 PRINT SPC( 2);"TAB"; SPC( 2);"CTRL-S"; SPC( 2);"CTRL-A ";
1210 RETURN
1220 :
1230 REM GET KEY FROM KEYBOARD
1240 K = PEEK(49152): IF K <128 THEN 1240
1250 K = K -128: POKE 49168,0: RETURN
1260 :
1270 REM CLEAR LINE
1280 VTAB 24: POKE HT,0: PRINT SPC( 79);: RETURN
1290 :
1300 REM GET LINE FROM KEYBOARD
1310 V = PEEK(37) +1:H = 30
1320 GL$ = ""
1330 GOSUB 1240: REM GET KEY
1340 IF K = 13 THEN RETURN : REM RETURN
1350 LL = LEN(GL$)
1360 IF K = 27 THEN 1490: REM ESC -- BACKUP
1370 IF K < >8 AND K < >127 THEN 1430: REM NOT LEFT
1380 LL = LL -1: REM LEFT
1390 IF LL >0 THEN GL$ = LEFT$(GL$,LL)
1400 IF LL = 0 THEN GL$ = ""
1410 VTAB V: POKE HT,H +LL +1: PRINT " ";
1420 GOTO 1330: REM GET ANOTHER CHARACTER
1430 IF LL = 40 THEN 1330: REM LIMIT 40 CHARACTERS
1440 IF IS = 0 AND K >47 AND K <58 THEN GL$ = GL$ + CHR$(K): REM #
1450 IF IS = 1 AND K >31 THEN GL$ = GL$ + CHR$(K): REM STRING
1460 VTAB V: POKE HT,H +LL +1
1470 IF LEN(GL$) >LL THEN PRINT CHR$(K);
1480 GOTO 1330: REM GET NEXT CHARACTER
1490 IF LL >0 THEN VTAB V: POKE HT,H: PRINT SPC( LL +1): GOTO 1320
1500 GL$ = CHR$(27)
1510 RETURN : REM escape when blank
1520 :
1530 REM CHECK FILETYPE
1540 NM$ = MID$ (FI$(I),2,16): REM GET FILENAME
1550 FOR J = 1 TO 15: REM TO STRIP TRAILING BLANKS
1560 IF RIGHT$(NM$,1) = " " THEN NM$ = LEFT$(NM$, LEN(NM$) -1)
1570 NEXT J
1580 FT$ = MID$ (FI$(I),18,3): REM get file type
1590 IF FT$ = "DIR" THEN P$ = P$ +"/" +NM$: GOTO 1850: REM READ NEW DIR
1600 VTAB 24: POKE HT,0: INVERSE
1610 PRINT "Not a subdirectory. Press any key";
1620 NORMAL : GOSUB 1240
1630 GOSUB 1280: GOTO 930
1640 :
1650 REM CHECK FOR ESCAPE
1660 E = PEEK(49152):E = E -128: POKE 49168,0
1670 IF E = 27 THEN POP : GOTO 1710: REM ESCAPE
1680 RETURN
1690 :
1700 REM RESTART
1710 VTAB 23: POKE HT,78: PRINT D$: REM FOR DOS3.3
1720 PRINT D$;"CLOSE": GOSUB 1280
1730 IF LA$ = "" THEN 1880: REM DIRECTORY NOT READ
1740 SV = 0: IF PD = 1 THEN DL = 20: REM RESET FOR READING PRODOS DIR
1750 VTAB 24: POKE HT,0
1760 INVERSE : PRINT "DISPLAY PREVIOUS DIRECTORY? <Y>";: NORMAL
1770 GOSUB 1240: IF K = 78 OR K = 110 OR K = 27 THEN GOSUB 1280: GOTO 1880
1780 IF K < >89 AND K < >121 AND K < >13 THEN 1750
1790 GOSUB 1280: IF PD = 0 THEN TF = 0: GOTO 2540: REM CLEAR; DOS 3.3
1800 NP$ = P$
1810 NP$ = LEFT$(NP$, LEN(NP$) -1): REM STRIP SUBDIRECTORY NAME
1820 IF RIGHT$(NP$,1) < >"/" THEN 1810
1830 IF LEN(NP$) = 1 THEN 1850: REM WAS ROOT DIRECTORY
1840 P$ = LEFT$(NP$, LEN(NP$) -1): REM STRIP TRAILING SLASH
1850 VTAB 23: POKE HT,0: PRINT SPC( 80);
1860 VTAB 23: POKE HT,0: INVERSE : PRINT "READING DIRECTORY ";P$;
1870 NORMAL : GOTO 540: REM RESET PREFIX
1880 POKE HT,0: VTAB 24: INVERSE : PRINT "RESTART? <Y> ";: NORMAL
1890 NORMAL : GOSUB 1240: IF K = 78 OR K = 110 OR K = 27 THEN END
1900 IF K < >89 AND K < >121 AND K < >13 THEN 1880
1910 GOTO 230: REM GREETING
1920 :
1930 REM INPUT DOS3.3 DISK NAME
1940 PRINT : PRINT SPC( 8);
1950 PRINT "NAME FOR DOS3.3 DISK: ";
1960 IS = 1: GOSUB 1310:P$ = GL$: REM GET LINE
1970 IF P$ = "" OR P$ = CHR$(27) THEN 1880: REM CHECK FOR END
1980 :
1990 REM CHECK DOS3.3 DRIVE
2000 DR = PEEK(43624)
2010 PRINT
2020 POKE HT,8: PRINT "INSERT DISK IN DRIVE 1";
2030 PRINT " AND PRESS ANY KEY ";
2040 GOSUB 1240: REM GET KEY
2050 PRINT : PRINT
2060 IF K = 27 THEN 1880: REM CHECK FOR END
2070 IF DR < >1 THEN PRINT D$: PRINT D$;"VERIFY HELLO,D1": REM CHANGE DRIVE
2080 POKE HT,8: PRINT "READING DOS3.3 DIRECTORY": NORMAL
2090 :
2100 REM LOAD DOSCAT MACHINE LANGUAGE ROUTINES
2110 RESTORE
2120 READ A$,B$: FOR I = 1 TO 49
2130 A = 16 * ASC( MID$ (A$,I)) + ASC( MID$ (B$,I)) -816
2140 POKE 767 +I,A: NEXT :P = 47080
2150 FOR I = 1 TO 5: READ A,B: POKE P +A,B: NEXT
2160 DATA "2>02=062>=8888:::1831;0>:=0<:??<2790=>:0:02>>29=6"
2170 DATA "033093003?5546210=8011001059003:9?100<50410930::0"
2180 DATA 3,0,4,17,8,187,9,180,12,1
2190 :
2200 REM READ DOS3.3 DIRECTORY INFORMATION
2210 A = FRE(0):K = 1:P = 47080:NL = 0
2220 FOR S = 1 TO 15: POKE P +5,16 -S: CALL 768
2230 FOR J = 0 TO 6:I = 46281 +J *35:T = PEEK(I -3)
2240 IF T = 0 THEN K = K -1: GOTO 2480: REM END OF DIRECTORY
2250 IF T = 255 THEN 2470: REM DELETED FILE
2260 POKE 1,I/256: POKE 0,I -256 * PEEK(1)
2270 CALL 775C$: REM GET FILENAME
2280 TL = PEEK(I -1): REM GET FILETYPE AND LOCK BIT
2290 LK$ = " ": IF TL >127 THEN LK$ = "*": REM LOCK BIT
2300 IF TL >127 THEN TL = TL -128: REM STRIP LOCK BIT
2310 FT$ = " ": IF TL = 0 THEN FT$ = "T": REM TEXT
2320 IF TL = 1 THEN FT$ = "I": REM INTEGER
2330 IF TL = 2 THEN FT$ = "A": REM APPLESOFT
2340 IF TL = 4 THEN FT$ = "B": REM BINARY
2350 IF TL = 8 THEN FT$ = "S": REM TYPE S FILE
2360 IF TL = 16 THEN FT$ = "R": REM RELOCATABLE FILE
2370 IF TL = 32 THEN FT$ = "A": REM TYPE A FILE
2380 IF TL = 64 THEN FT$ = "B": REM TYPE B FILE
2390 FL = PEEK(I +30): REM GET FILE LENGTH
2400 L$ = STR$(FL): IF LEN(L$) = 1 THEN L$ = "00" +L$
2410 IF LEN(L$) = 2 THEN L$ = "0" +L$: REM RIGHT JUSTIFY
2420 SP = 30 - LEN(C$): REM FILL-IN SPACES FOR FILENAME
2430 DI$(K) = LK$ +C$: FOR M = 1 TO SP +1:DI$(K) = DI$(K) +" ": NEXT M
2440 DI$(K) = DI$(K) +FT$ +" " +L$: REM PRODOS ORDER
2450 REM LK$ + FT$ + " " + L$ + " " + C$ IS STANDARD DOS3.3 FORMAT
2460 K = K +1
2470 NEXT : NEXT
2480 ND = K: REM NUMBER OF FILES IN DIRECTORY
2490 X = FRE(0): REM CLEAR OLD STRINGS FROM MEMORY
2500 TF = 0: REM RESET TRANSFER COUNTER
2510 LA$ = "Y": REM RESET FLAG FOR RESTART
2520 :
2530 REM TRANSFER DOS3.3 DIRECTORY INFORMATION
2540 IF TF = ND THEN 850: REM NO MORE FILES
2550 IF TF = 0 THEN EOD = 0:PG = 0
2560 PG = PG +1:NL = DL: IF (ND -TF) <DL THEN NL = ND -TF
2570 FOR J = 1 TO NL
2580 TF = TF +1:FI$(J) = DI$(TF)
2590 NEXT J: IF TF = ND THEN EOD = 1
2600 OI = 1: GOTO 850: REM SELECT DIRECTORY FILE
2610 :
2620 REM ROUTINE TO CHANGE WIDTH OF DISPLAY
2630 TC = TC +1: IF TC = 10 THEN TC = 1
2640 WB = WP(TC):W = WP(TC): REM PRODOS LABELS
2650 IF PD = 0 THEN W = WD(TC): IF TC >3 THEN W = 37: REM DOS3.3
2660 GOTO 850: REM SELECT DIRECTORY ENTRY
2670 :
2680 REM OPEN OUTPUT FILE
2690 VTAB 23: POKE HT,79: PRINT D$: REM FOR DOS3.3
2700 PRINT D$;"CLOSE"
2710 VTAB 24: POKE HT,0
2720 IF SV = 1 THEN PRINT "SAVE FILE ";
2730 IF SV = 2 THEN PRINT "APPEND FILE ";
2740 IF PD = 1 THEN PRINT "PATHNAME: ";
2750 IF PD = 0 THEN PRINT "NAME [,D2]: ";
2760 IS = 1: GOSUB 1310:PW$ = GL$: REM GET LINE
2770 IF GL$ = "" OR GL$ = CHR$(27) THEN GOSUB 1280: GOTO 930
2780 VTAB 23: POKE HT,40: PRINT "OPENING FILE"
2790 VF = 1: PRINT D$;"VERIFY";PW$:VF = 0: REM IF ERROR=6 THEN DOESN'T EXIST
2800 IF SV = 2 THEN 2910: REM OK IF EXISTS FOR APPEND
2810 GOSUB 1280: VTAB 24: POKE HT,0
2820 PRINT "FILE ";PW$;" ALREADY EXISTS. DELETE IT? <N> ";
2830 GOSUB 1240: VTAB 23: POKE HT,78: PRINT D$: REM PRINT FOR DOS3.3
2840 IF K = 121 OR K = 89 THEN PRINT D$;"DELETE";PW$: GOTO 2910
2850 IF K < >78 AND K < >110 AND K < >27 AND K < >13 THEN 2830
2860 GOSUB 1280: GOTO 2710: REM GET NEW PATHNAME
2870 IF SV = 1 THEN 2910: REM OK IF DOESN'T EXIST FOR SAVE
2880 GOSUB 1280: VTAB 24: POKE HT,0
2890 PRINT "FILE ";PW$;" DOES NOT EXIST -- PRESS ANY KEY";
2900 GOSUB 1240: GOSUB 1280: GOTO 2710: REM GET NEW PATHNAME
2910 VTAB 23: POKE HT,78: PRINT D$: REM FOR DOS3.3
2920 PRINT D$;"OPEN";PW$
2930 CM$ = "": REM FOR STRIPPING [,D2]
2940 IF LEN(PW$) >3 THEN CM$ = MID$ (PW$, LEN(PW$) -2,1)
2950 IF CM$ = CHR$(44) THEN PW$ = LEFT$(PW$, LEN(PW$) -3)
2960 IF SV = 2 THEN 3080: REM READ FORMAT FOR APPEND
2970 :
2980 REM GET FORMAT FOR SAVE
2990 GOSUB 1280: VTAB 24: POKE HT,0
3000 PRINT "FORMAT: [1] AW20-DB [2] AWGS-DB [3] TEXT <1>? ";
3010 GOSUB 1240: IF K = 49 OR K = 13 THEN DB = 1: GOTO 3510
3020 IF K = 50 THEN DB = 2: GOTO 3510: REM WRITE OUTPUT
3030 IF K = 51 THEN DB = 3: GOTO 3510: REM WRITE OUTPUT
3040 IF K = 27 THEN GOSUB 1280: GOTO 930
3050 GOTO 2990: REM INCORRECT CHOICE
3060 :
3070 REM READ FORMAT FOR APPEND
3080 PRINT D$;"READ";PW$
3090 NI = 0:NR = 0:NN$ = ""
3100 RA = 1: REM IF ERROR 5 THEN CHECK IF NR>0
3110 GET C$: IF C$ = CHR$(47) OR C$ = CHR$(44) THEN 3160
3120 GOSUB 1280: VTAB 24: POKE HT,0
3130 PRINT PW$;" HAS INCORRECT FORMAT -- PRESS ANY KEY";
3140 VTAB 23: POKE HT,78: PRINT D$: REM FOR DOS3.3
3150 PRINT D$;"CLOSE": GOSUB 1240: GOSUB 1280: GOTO 2710
3160 GET C$: REM SKIP DIR NAME
3170 IF C$ < > CHR$(9) AND C$ < > CHR$(13) THEN 3160
3180 GET C$: REM FOR FIELDS
3190 IF C$ = CHR$(47) OR C$ = CHR$(44) THEN 3280
3200 IF NR >11 THEN 3120: REM TOO MANY FIELDS
3210 IF C$ = CHR$(9) THEN NI = NI +1: GOTO 3180: REM COUNT TABS
3220 IF C$ = CHR$(13) THEN 3260: REM CARRIAGE RETURN
3230 NN$ = NN$ +C$: REM STORE FILENAME
3240 IF NN$ = " NAME" THEN 3300: REM TEXT LABEL
3250 GOTO 3180: REM READ MORE OF FIELDS
3260 IF NI >0 THEN AF = NI +2:AD = 2: GOTO 3390: REM AWGS FORMAT
3270 NR = NR +1: GOTO 3180: REM COUNT RETURNS
3280 IF NR >0 THEN AF = NR +1:AD = 1: GOTO 3390: REM AW20 FORMAT
3290 GOTO 3120: REM NO FIELDS
3300 GET C$: REM FOR LABELS
3310 IF C$ = CHR$(13) THEN 3330
3320 NN$ = NN$ +C$: GOTO 3300: REM STORE LABELS
3330 IF PD = 0 THEN 3360
3340 FOR I = 1 TO 9: IF LEN(NN$) = WP(I) THEN AF = I +1: GOTO 3380
3350 NEXT : GOTO 3120: REM WRONG LENGTH IN PRODOS
3360 FOR I = 1 TO 3: IF LEN(NN$) = WD(I) THEN AF = I +1: GOTO 3380
3370 NEXT : GOTO 3120: REM WRONG LENGTH IN DOS3.3
3380 AD = 3: REM TEXT FORMAT
3390 VTAB 23: POKE HT,0: PRINT D$: REM FOR DOS3.3
3400 RA = 0: PRINT D$"CLOSE";PW$
3410 GOSUB 1280: VTAB 24: POKE HT,0
3420 PRINT "USE ";AF;" FIELDS IN ";AD$(AD);" FORMAT <Y>? ";
3430 GOSUB 1240: VTAB 23: POKE HT,78: PRINT D$: REM PRINT FOR DOS3.3
3440 IF K = 78 OR K = 110 OR K = 27 THEN GOSUB 1280: GOTO 850
3450 IF K < >89 AND K < >121 AND K < >13 THEN 3430
3460 DB = AD:TC = AF -1: IF DB <3 THEN TC = AF -2: REM SET FORMAT
3470 WB = WP(TC):W = WP(TC): IF PD = 0 THEN W = WD(TC): IF TC >3 THEN W = 37
3480 PRINT D$;"APPEND";PW$: PRINT D$: REM DON'T WRITE YET
3490 :
3500 REM WRITE OUTPUT FILE
3510 VTAB 23: POKE HT,0:: PRINT SPC( 80)
3520 NF = TC +1: IF DB <3 THEN NF = TC +2
3530 GOSUB 1280
3540 VTAB 23: POKE HT,0: INVERSE
3550 PRINT "WRITING FILE ";PW$;" IN FORMAT ";DB;: NORMAL
3560 IF PD = 1 THEN DL = 100: GOTO 610: REM OPEN DIRECTORY
3570 GOSUB 1660: REM CHECK FOR ESCAPE
3580 PRINT D$: PRINT D$;"WRITE";PW$
3590 IF PD = 0 THEN NL = ND: REM DOS3.3 HAS ALL IN MEMORY
3600 IF DB <3 THEN 3720: REM DATABASE FORMAT
3610 IF FS = 0 AND SV = 2 THEN PRINT : PRINT : REM BLANKS BETWEEN DIR
3620 IF FS = 0 AND PD = 0 THEN PRINT CHR$(44);: REM COMMA FOR DOS3.3
3630 IF FS = 0 THEN PRINT P$: PRINT
3640 IF FS = 0 AND PD = 1 THEN PRINT LEFT$(LB$,W): PRINT
3650 IF FS = 0 AND PD = 0 THEN PRINT LEFT$(LD$,W): PRINT : REM DOS3.3
3660 FOR I = 1 TO NL: GOSUB 1660
3670 IF PD = 1 THEN WI$ = FI$(I): REM PRODOS
3680 IF PD = 0 THEN WI$ = DI$(I): REM DOS3.3
3690 IF LEN(WI$) >W THEN WI$ = LEFT$(WI$,W)
3700 PRINT WI$: NEXT
3710 GOTO 4090
3720 SC$ = CHR$(13): IF DB = 2 THEN SC$ = CHR$(9): REM AW20 VS.AWGS
3730 FOR I = 1 TO NL: GOSUB 1660
3740 IF PD = 0 THEN 3880
3750 WI$ = FI$(I): REM PRODOS
3760 IF LEN(WI$) >W THEN WI$ = LEFT$(WI$,W)
3770 WK$ = MID$ (WI$,1,1)
3780 WN$ = MID$ (WI$,2,15)
3790 WT$ = MID$ (WI$,18,3)
3800 WB$ = MID$ (WI$,22,7)
3810 WM$ = MID$ (WI$,31,9)
3820 WH$ = MID$ (WI$,41,5)
3830 WC$ = MID$ (WI$,48,9)
3840 WR$ = MID$ (WI$,58,5)
3850 WE$ = MID$ (WI$,64,8)
3860 WS$ = MID$ (WI$,73,7)
3870 GOTO 3960
3880 WI$ = DI$(I): REM DOS3.3
3890 IF LEN(WI$) >W THEN WI$ = LEFT$(WI$,W)
3900 WK$ = MID$ (WI$,1,1)
3910 WN$ = MID$ (WI$,2,30)
3920 WT$ = MID$ (WI$,33,1)
3930 WB$ = " " + MID$ (WI$,35,3): REM 4 SPACES
3940 WM$ = "":WH$ = "":WC$ = "":WR$ = "":WE$ = "":WS$ = ""
3950 IF PD = 0 THEN PRINT CHR$(44);: REM COMMA FOR DOS3.3
3960 PRINT P$;
3970 PRINT SC$;WK$;
3980 PRINT SC$;WN$;
3990 IF TC >1 THEN PRINT SC$;WT$;
4000 IF TC >2 THEN PRINT SC$;WB$;
4010 IF TC >3 THEN PRINT SC$;WM$;
4020 IF TC >4 THEN PRINT SC$;WH$;
4030 IF TC >5 THEN PRINT SC$;WC$;
4040 IF TC >6 THEN PRINT SC$;WR$;
4050 IF TC >7 THEN PRINT SC$;WE$;
4060 IF TC >8 THEN PRINT SC$;WS$;
4070 PRINT
4080 NEXT
4090 IF PD = 1 AND EOD = 0 THEN FS = FS +NL: GOTO 620: REM READ MORE
4100 IF PD = 1 AND DB = 3 THEN PRINT : PRINT ST$: REM DIR STATISTICS
4110 PRINT D$: REM EXTRA FOR DOS3.3
4120 PRINT D$;"CLOSE";PW$
4130 I = OI: VTAB 23: POKE HT,0: INVERSE
4140 PRINT NF;" FIELDS WRITTEN IN FORMAT ";DB;" ON ";PW$;: NORMAL
4150 GOSUB 1280: GOTO 1710: REM RESTART
4160 :
4170 REM ERROR ROUTINE
4180 EN = PEEK(222): REM GET ERROR NUMBER
4190 EL = PEEK(219) *256 + PEEK(218): REM GET LINE
4200 POKE 216,0: REM RESET ERROR TRAPPING
4210 ONERR GOTO 4180
4220 IF EN = 6 AND PD = 0 AND LA$ = "" THEN 2080: REM CHANGE DOS3.3. DRIVE
4230 IF EN = 6 AND VF = 1 THEN VF = 0: GOTO 2870: REM OUTPUT FILE NOT FOUND
4240 IF EN = 5 AND RA = 1 THEN RA = 0: GOTO 3280: REM CHECK NR>0
4250 IF EN = 255 THEN END : REM TRAPPED CTRL-C
4260 PRINT D$: PRINT D$;"CLOSE": REM CLOSE ALL FILES
4270 VTAB 23: POKE HT,0
4280 INVERSE : PRINT "ERROR ";EN;" ON LINE ";EL;
4290 IF EN = 254 THEN 1710: REM TRAPPED ESC
4300 IF EN = 2 THEN PRINT " -- RANGE ERROR";
4310 IF EN = 4 THEN PRINT " -- WRITE PROTECTED";
4320 IF EN = 6 THEN PRINT " -- PATH NOT FOUND";
4330 IF EN = 8 THEN PRINT " -- I/O ERROR";
4340 IF EN = 9 THEN PRINT " -- DISK FULL";
4350 IF EN = 10 THEN PRINT " -- FILE LOCKED";
4360 IF EN = 11 OR EN = 16 THEN PRINT " -- SYNTAX ERROR";
4370 PRINT " -- ";: NORMAL
4380 INVERSE
4390 PRINT "PRESS ANY KEY ";: NORMAL : PRINT " ";
4400 GOSUB 1240: REM GET KEY
4410 GOTO 1710: REM RESTART